home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbnws105.zip / ZV.ZIP / ZV.BAS < prev   
BASIC Source File  |  1990-10-24  |  15KB  |  501 lines
  1. ' ZV      BAS : A Quick Basic archive file viewer for MS-DOS machines
  2. ' author .....: Dick Dennison    [74270,3636]  914-374-3903 3/12/24 24 hrs
  3. ' supports ...: ZIP, LZH, ARC, PAK, ZOO archive formats
  4. ' syntax .....: ZV FILENAME
  5. ' returns ....: The member filespecs in the archive
  6. ' includes ...: DIXARC02.INC = contains archive structures
  7. ' notes ......: All output is thru dos
  8. '             : This is to allow easy porting to comm port routines
  9. ' cost .......: Free = Credit where credit due
  10. '             : Do not use as is for commercial use - may not be resold
  11. '             : May not be rebundled without prior written consent
  12. ' trademarks .: ZIP is the property of Phil Katz
  13. '             : ARC is the property of SEA
  14. '             : ZOO is the property of Rahul Dhesi
  15. '             : PAK is the property of NoGate Consulting
  16. '             : Lharc is the property of Yoshi
  17. '             : MS-DOS is the property of MicroSoft
  18. ' dated ......: 10/24/90
  19.  
  20. DECLARE SUB pakview (filestr$)
  21. DECLARE SUB zooview (filestr$)
  22. DECLARE SUB arcview (filestr$)
  23. DECLARE SUB getname (filestr$)
  24. DECLARE FUNCTION fixtime$ (parm%)
  25. DECLARE FUNCTION fixdate$ (parm%)
  26. DECLARE SUB viewlzh (filestr$)
  27. DECLARE SUB showmsg (Msg$)
  28. DECLARE SUB zipview (filestr$)
  29.  
  30. '$INCLUDE: 'dixarc02.inc'
  31.  
  32. DIM SHARED mon(13) AS STRING
  33. mon$(1) = "-Jan-": mon$(2) = "-Feb-": mon$(3) = "-Mar-": mon$(4) = "-Apr-"
  34. mon$(5) = "-May-": mon$(6) = "-Jun-": mon$(7) = "-Jul-": mon$(8) = "-Aug-":
  35. mon$(9) = "-Sep-": mon$(10) = "-Oct-": mon$(11) = "-Nov-": mon$(12) = "-Dec-"
  36. DIM SHARED banner$
  37. banner$ = STRING$(75, "═")
  38.  
  39. OPEN "cons:" FOR OUTPUT AS 5   'See showmsg for info on this
  40. showmsg CHR$(10) + CHR$(13)
  41.  
  42. IF COMMAND$ = "" THEN
  43.     showmsg "ZV filename   {where filename is a PAK,ARC,ZIP,ZOO,LZH file}"
  44.     END
  45. END IF
  46. getname COMMAND$
  47. END
  48.  
  49. SUB arcview (filestr$)
  50. DIM arc AS header   'header is in include file
  51.  
  52. OPEN filestr$ FOR BINARY AS 1 LEN = LEN(arc)
  53.  
  54. 'Display Banner
  55. b$ = "DIX ARCview - Archive: " + filestr$ + STR$(LOF(1))
  56. c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
  57. b$ = c$ + b$
  58. showmsg b$
  59. showmsg banner$
  60.  
  61. b$ = "Filename        Size    Old Size  Date       Time       Method    CRC"
  62. showmsg b$
  63. showmsg banner$
  64.  
  65. leng& = LOF(1)
  66. FOR n% = 1 TO 100   'arbitrary number
  67.     GET 1, , arc
  68.     sig% = arc.arcid AND 255   'Low order of byte is ID signature
  69.     meth% = arc.arcid \ 256    'Method of compression in high order
  70.     IF sig% <> 26 THEN
  71.         n% = n% - 1
  72.         EXIT FOR
  73.     END IF
  74.     IF meth% < 1 THEN
  75.         n% = n% - 1
  76.         EXIT FOR
  77.     END IF
  78.     ntime$ = fixtime$(arc.atime)
  79.     ndate$ = fixdate$(arc.adate)
  80.     mark% = INSTR(arc.filename, ".")
  81.     IF mark% < 2 THEN mark% = 9  'incase filename has no extension
  82.    
  83.     'Parse filename and format for printing
  84.     filename$ = LEFT$(arc.filename, mark% - 1) + MID$(arc.filename, mark%, 4)
  85.   SELECT CASE meth%        ' Select correct compression text
  86.     CASE IS = 1
  87.         met$ = "------  "  ' No compression used
  88.     CASE IS = 2
  89.         met$ = "Stored  "  ' Repeated running length encoding (RLE)
  90.     CASE IS = 3
  91.         met$ = "Packed  "  ' Huffman encoding
  92.     CASE IS = 4
  93.         met$ = "Squeezed"  ' LZW with 4K buffer, 12 bits codes
  94.     CASE IS = 5
  95.         met$ = "crunched"  ' First packing, then LZW 4K buffer with 12 bits
  96.     CASE IS = 6
  97.         met$ = "crunched"  ' Packing, LZW, 4K buffer, vari len (9-12 bits)
  98.     CASE IS = 7
  99.         met$ = "Crunched"  ' LZW, 8K buffer, variable length (9-13 bits)
  100.     CASE IS = 8
  101.         met$ = "Crunched"
  102.     CASE IS = 9
  103.         met$ = "Squashed"
  104.     CASE IS = 10
  105.         met$ = "Crushed "  ' Packing, then LZW 8K buffer, 2-13 bits (PAK 1.0)
  106.     CASE IS = 11
  107.         met$ = "Distill "  ' Dynamic Huffman with 8K buffer (PAK 2.0)
  108.     CASE ELSE
  109.         met$ = "--------"  ' usually -1
  110.   END SELECT
  111.  
  112.   totcomp& = totcomp& + arc.newsize  'Get the totals for the archive
  113.   totunc& = totunc& + arc.oldsize
  114.  
  115.   'Because the filesizes are different lengths we need to
  116.   'Parse the display and add spacing
  117.   c$ = SPACE$(15 - LEN(filename$))
  118.   d$ = SPACE$(8 - LEN(STR$(arc.newsize)))
  119.   e$ = SPACE$(11 - LEN(STR$(arc.oldsize)))
  120.  
  121.   b$ = filename$ + c$ + STR$(arc.newsize) + d$ + STR$(arc.oldsize) + e$ + ndate$ + "  " + ntime$ + "   " + met$ + "  " + HEX$(arc.CRC) + cr$
  122.   showmsg b$
  123.  
  124.   where& = SEEK(1)
  125.   IF totcomp& + n% * LEN(arc) >= leng& THEN EXIT FOR
  126.   IF LEN(header) + where& + arc.newsize >= leng& THEN EXIT FOR 'At end yet?
  127.   SEEK 1, where& + arc.newsize   'Position read/write head for next file get
  128. NEXT n%
  129. CLOSE 1
  130. 'Show trailer
  131. showmsg banner$
  132. b$ = STR$(n%) + " files" + SPACE$(7) + STR$(totcomp&) + "  " + STR$(totunc&) + cr$
  133. showmsg b$
  134.  
  135. END SUB
  136.  
  137. FUNCTION fixdate$ (parm%)
  138. 'Date and time are in packed format - these are the breakouts
  139. 'bits 00h-04h = day (1-31)
  140. 'bits 05h-08h = month (1-12)
  141. 'bits 09h-0Fh = year (relative to 1980)
  142.  
  143. day% = parm% AND 31        'get bits 0-4
  144. dayz$ = LTRIM$(STR$(day%))
  145. IF LEN(dayz$) = 1 THEN dayz$ = "0" + (dayz$)  'Parse and add leading 0 if needed
  146. parm% = parm% \ 32         'shift left 5
  147. month% = parm% AND 15      'get bits 5-8
  148. parm% = parm% \ 16         'shift left 4
  149. year% = (parm% AND 255) + 80    'get bits 9-15 and add to 1980
  150. moddate$ = dayz$ + mon$(month%) + LTRIM$(STR$(year%))  'Format is 20-Oct-90
  151.  
  152. fixdate$ = moddate$
  153.  
  154. END FUNCTION
  155.  
  156. FUNCTION fixtime$ (parm%)
  157. 'Date and time are in packed format - these are the breakouts
  158. 'bits 00h-04h = 2 second incs (0-29)
  159. 'bits 05h-0Ah = minutes (0-59)
  160. 'bits 0Bh-0Fh = hours (0-23)
  161.  
  162. Temp& = parm%
  163. IF parm% < 0 THEN Temp& = Temp& + 65536  'Check for sign (+ -)
  164. secs% = (Temp& AND 31) * 2  'get bits 0-4 and multiply by 2
  165. Temp& = Temp& \ 32          'shift right 5
  166. mins% = Temp& AND 63        'get bits 5-10
  167. Temp& = Temp& \ 64          'shift right 6
  168. hours% = Temp& AND 31       'get bits 11-15
  169. sec$ = LTRIM$(STR$(secs%))
  170. IF LEN(sec$) = 1 THEN sec$ = "0" + sec$    'Parse and add leading 0's
  171. min$ = LTRIM$(STR$(mins%))
  172. IF LEN(min$) = 1 THEN min$ = "0" + min$    'if needed
  173. hour$ = LTRIM$(STR$(hours%))
  174. IF LEN(hour$) = 1 THEN hour$ = "0" + hour$
  175.  
  176. modtime$ = hour$ + ":" + min$ + ":" + sec$  'Format is 01:30:46
  177. fixtime$ = modtime$
  178.  
  179. END FUNCTION
  180.  
  181. SUB getname (filestr$)
  182. OPEN filestr$ FOR APPEND AS 1
  183. IF LOF(1) = 0 THEN              'If file exist continue
  184.     CLOSE 1
  185.     KILL filestr$
  186.     showmsg "File not Found"
  187.     END
  188. END IF
  189. CLOSE 1
  190.                                 'Get file extension
  191. mark% = INSTR(filestr$, ".")
  192. a$ = MID$(filestr$, mark% + 1)
  193.  
  194. SELECT CASE UCASE$(a$)
  195.     CASE "LZH"
  196.         viewlzh filestr$
  197.     CASE "ZIP"
  198.         zipview filestr$
  199.     CASE "ARC"
  200.         arcview filestr$
  201.     CASE "ZOO"
  202.         zooview filestr$
  203.     CASE "PAK"
  204.         pakview filestr$
  205.     CASE ELSE
  206.         showmsg "Cannot view " + filestr$
  207.         END
  208. END SELECT
  209. END SUB
  210.  
  211. SUB pakview (filestr$)
  212. DIM pak AS paktype
  213.  
  214. OPEN filestr$ FOR BINARY AS 1
  215.  
  216. 'Format and display banner
  217. b$ = "DIX PAKview - Archive : " + filestr$ + "  " + STR$(LOF(1)) + " bytes"
  218. c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
  219. b$ = c$ + b$
  220. showmsg b$
  221. showmsg banner$
  222. b$ = "Filename       Old size   New size  Method     Date        Time     CRC"
  223. showmsg b$
  224. showmsg banner$
  225.  
  226. FOR n% = 1 TO 100    'arbitrary number
  227.     
  228.     GET 1, , pak
  229.     SELECT CASE ASC(pak.version)
  230.         CASE 0 '  End of file.  File header is only 2 bytes long (26 and 0).
  231.             meth$ = "---------"
  232.         CASE 1 ' No compression. File header lacks the Length field.
  233.             meth$ = "---------"
  234.         CASE 2 ' No compression.
  235.             meth$ = "None     "
  236.         CASE 3 ' Run-length encoding (RLE).
  237.             meth$ = "REL      "
  238.         CASE 4 ' Huffman squeezing.
  239.             meth$ = "Huffman  "
  240.         CASE 5 ' Fixed-length 12 bit LZW compression.
  241.             meth$ = "12bit LZW"
  242.         CASE 6 ' As above, with RLE.
  243.             meth$ = "LZW w RLE"
  244.         CASE 7 ' As above, but with a different hashing scheme.
  245.             meth$ = "LZW w RLE"
  246.         CASE 8 ' Variable-length 9-12 bit LZW compression with RLE.
  247.             meth$ = "LZW w RLE"
  248.         CASE 9 ' Variable-length 9-13 bit LZW compression without RLE.
  249.             meth$ = "LZW n RLE"
  250.         CASE 10' Crushing
  251.             meth$ = "Crushing "
  252.         CASE 11
  253.             meth$ = "Distilled"
  254.         CASE ELSE
  255.             meth$ = "Unknown  "
  256.     END SELECT
  257.    
  258.     mark% = INSTR(pak.filename, CHR$(0))
  259.     filename$ = LEFT$(pak.filename, mark%)
  260.     c$ = SPACE$(14 - LEN(filename$))
  261.     pdate$ = fixdate$(pak.Date)
  262.     ptime$ = fixtime$(pa